VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Tokenizer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'     VBoost6.Dll (VBoost Object Implementation (6.0)) (optional)
'   Files:
'     ArrayOwner.Bas or ArrayOwnerIgnoreOnly.Bas
'     VBoost.bas (optional)
'   Minimal VBoost conditionals:
'     VBOOST_INTERNAl = 1 : VBOOST_CUSTOM = 1
'   Conditional Compilation Values:
'     NOVBOOST = 1 'Removes VBoost dependency
'
' This file is discussed in Chapter 14.
'***************************************************************
Option Explicit

Private Type OwnedInteger
    Owner As ArrayOwner
    pSA() As Integer
End Type

'The complete set of tokens
Private m_Tokens As String
'An owned integer array pointing to m_Tokens
Private m_RefTokens As OwnedInteger
'The last end of line token, stop processing if tokens
'before this are hit
Private m_LastEOLToken As Integer
'The last token that is a delimiter we should keep.
'All tokens after this one are tossed.
Private m_LastKeepToken As Integer
'An owned integer array pointing to the line being processed
Private m_RefLine As OwnedInteger
Private Const iDoubleQuote As Integer = 34

Public Sub SetDelimiters(TossDelimiters As String, KeepDelimiters As String, StopAt As String)
    m_LastEOLToken = Len(StopAt)
    m_LastKeepToken = m_LastEOLToken + Len(KeepDelimiters)
    m_Tokens = StopAt & KeepDelimiters & TossDelimiters
    With m_RefTokens.Owner.SA
        .pvData = StrPtr(m_Tokens)
        .cElements = Len(m_Tokens)
    End With
End Sub

Public Function TokenizeLine(strLine As String, iStoppedAt As Integer, strReturn() As String) As Integer
Const RedimIncrement = 20 'The grow size of the return array
Dim iRetArrSize As Integer 'The current size of the return array
Dim iPos As Integer 'The current position in strLine
Dim iMaxLen As Integer 'Cache for Len(strLine)
Dim iTestChar As Integer 'The character in the line being tested
Dim iStartPos As Integer 'The starting position of the current field
Dim iFieldLength As Integer 'The length of the current field
Dim iToken As Integer
Dim cTokens As Integer
Dim fHaveNextToken As Boolean
    
    TokenizeLine = 0
    
    'Plug the string into our SAFEARRAY structure
    iMaxLen = Len(strLine) 'Cache the length
    With m_RefLine
        With .Owner.SA
            .pvData = StrPtr(strLine)
            'Go to +1 so that trailing NULL terminator is in array
            .cElements = iMaxLen + 1
        End With
        iStoppedAt = 0
        cTokens = Len(m_Tokens)
        
        'The main processing loop
        Do While iPos < iMaxLen
            iStartPos = iPos 'Keep the current position
            iTestChar = .pSA(iPos)
            
            'See if we've hit any tokens
            If fHaveNextToken Then
                fHaveNextToken = False
            Else
                For iToken = 0 To cTokens - 1
                    If m_RefTokens.pSA(iToken) = iTestChar Then Exit For
                Next iToken
            End If
            If iToken = cTokens Then
                'Not a token character, check for double quote and next token
                If iTestChar = iDoubleQuote Then
                    'Consider quoted strings a single field
                    Do
                        iPos = iPos + 1
                        If iPos >= iMaxLen Then
                            Erase strReturn
                            Err.Raise 5
                        Else
                            iTestChar = .pSA(iPos)
                            If iTestChar = iDoubleQuote Then
                                'Check for 2 double quotes.  Note that this won't look
                                'beyond the end of the array because the array length
                                'for the line includes the trailing NULL.
                                If .pSA(iPos + 1) = iDoubleQuote Then
                                    iPos = iPos + 1
                                Else
                                    Exit Do
                                End If
                            End If
                        End If
                    Loop
                    iPos = iPos + 1
                    iFieldLength = iPos - iStartPos
                Else
                    'Walk until the next token is hit
                    Do
                        iPos = iPos + 1
                        If iPos = iMaxLen Then Exit Do
                        iTestChar = .pSA(iPos)
                        For iToken = 0 To cTokens - 1
                            If m_RefTokens.pSA(iToken) = iTestChar Then
                                fHaveNextToken = True
                                Exit Do
                            End If
                        Next iToken
                    Loop
                    iFieldLength = iPos - iStartPos
                End If
            ElseIf iToken < m_LastEOLToken Then
                iStoppedAt = iPos + 1
                Exit Do
            ElseIf iToken < m_LastKeepToken Then
                iPos = iPos + 1
                iFieldLength = 1
            Else 'Toss token
                iFieldLength = 0
                iPos = iPos + 1
            End If
            
            If iFieldLength Then
                'Return this field
                'Grow the array if necessary
                TokenizeLine = TokenizeLine + 1
                'Increment the size of the array in blocks to avoid Redim Preserve every time
                If TokenizeLine > iRetArrSize Then
                    iRetArrSize = iRetArrSize + RedimIncrement
                    ReDim Preserve strReturn(iRetArrSize - 1)
                End If
                'Save the field to return
                strReturn(TokenizeLine - 1) = Mid$(strLine, iStartPos + 1, iFieldLength)
            End If
        Loop
    End With
    If TokenizeLine Then
        'Remove unused array elements
        ReDim Preserve strReturn(TokenizeLine - 1)
    Else
        Erase strReturn
    End If
End Function

Private Sub Class_Initialize()
    InitArrayOwner m_RefTokens.Owner, 2, 0
    InitArrayOwner m_RefLine.Owner, 2, 0
End Sub

